home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / tcl / tcl70b2.lha / tcl7.0b2 / tclEnv.c < prev    next >
C/C++ Source or Header  |  1993-07-19  |  14KB  |  532 lines
  1. /* 
  2.  * tclEnv.c --
  3.  *
  4.  *    Tcl support for environment variables, including a setenv
  5.  *    procedure.
  6.  *
  7.  * Copyright (c) 1991-1993 The Regents of the University of California.
  8.  * All rights reserved.
  9.  *
  10.  * Permission is hereby granted, without written agreement and without
  11.  * license or royalty fees, to use, copy, modify, and distribute this
  12.  * software and its documentation for any purpose, provided that the
  13.  * above copyright notice and the following two paragraphs appear in
  14.  * all copies of this software.
  15.  * 
  16.  * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  17.  * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  18.  * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  19.  * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  20.  *
  21.  * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  22.  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  23.  * AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  24.  * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  25.  * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  26.  */
  27.  
  28. #ifndef lint
  29. static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclEnv.c,v 1.16 93/07/19 10:05:42 ouster Exp $ SPRITE (Berkeley)";
  30. #endif /* not lint */
  31.  
  32. /*
  33.  * The putenv and setenv definitions below cause any system prototypes for
  34.  * those procedures to be ignored so that there won't be a clash when the
  35.  * versions in this file are compiled.
  36.  */
  37.  
  38. #define putenv ignore_putenv
  39. #define setenv ignore_setenv
  40. #include "tclInt.h"
  41. #include "tclUnix.h"
  42. #undef putenv
  43. #undef setenv
  44.  
  45. /*
  46.  * The structure below is used to keep track of all of the interpereters
  47.  * for which we're managing the "env" array.  It's needed so that they
  48.  * can all be updated whenever an environment variable is changed
  49.  * anywhere.
  50.  */
  51.  
  52. typedef struct EnvInterp {
  53.     Tcl_Interp *interp;        /* Interpreter for which we're managing
  54.                  * the env array. */
  55.     struct EnvInterp *nextPtr;    /* Next in list of all such interpreters,
  56.                  * or zero. */
  57. } EnvInterp;
  58.  
  59. static EnvInterp *firstInterpPtr;
  60.                 /* First in list of all managed interpreters,
  61.                  * or NULL if none. */
  62.  
  63. static int environSize = 0;    /* Non-zero means that the all of the
  64.                  * environ-related information is malloc-ed
  65.                  * and the environ array itself has this
  66.                  * many total entries allocated to it (not
  67.                  * all may be in use at once).  Zero means
  68.                  * that the environment array is in its
  69.                  * original static state. */
  70.  
  71. /*
  72.  * Declarations for local procedures defined in this file:
  73.  */
  74.  
  75. static void        EnvInit _ANSI_ARGS_((void));
  76. static char *        EnvTraceProc _ANSI_ARGS_((ClientData clientData,
  77.                 Tcl_Interp *interp, char *name1, char *name2,
  78.                 int flags));
  79. static int        FindVariable _ANSI_ARGS_((CONST char *name,
  80.                 int *lengthPtr));
  81. void            TclSetEnv _ANSI_ARGS_((CONST char *name,
  82.                 CONST char *value));
  83. void            TclUnsetEnv _ANSI_ARGS_((CONST char *name));
  84.  
  85. /*
  86.  *----------------------------------------------------------------------
  87.  *
  88.  * TclSetupEnv --
  89.  *
  90.  *    This procedure is invoked for an interpreter to make environment
  91.  *    variables accessible from that interpreter via the "env"
  92.  *    associative array.
  93.  *
  94.  * Results:
  95.  *    None.
  96.  *
  97.  * Side effects:
  98.  *    The interpreter is added to a list of interpreters managed
  99.  *    by us, so that its view of envariables can be kept consistent
  100.  *    with the view in other interpreters.  If this is the first
  101.  *    call to Tcl_SetupEnv, then additional initialization happens,
  102.  *    such as copying the environment to dynamically-allocated space
  103.  *    for ease of management.
  104.  *
  105.  *----------------------------------------------------------------------
  106.  */
  107.  
  108. void
  109. TclSetupEnv(interp)
  110.     Tcl_Interp *interp;        /* Interpreter whose "env" array is to be
  111.                  * managed. */
  112. {
  113.     EnvInterp *eiPtr;
  114.     int i;
  115.  
  116.     /*
  117.      * First, initialize our environment-related information, if
  118.      * necessary.
  119.      */
  120.  
  121.     if (environSize == 0) {
  122.     EnvInit();
  123.     }
  124.  
  125.     /*
  126.      * Next, add the interpreter to the list of those that we manage.
  127.      */
  128.  
  129.     eiPtr = (EnvInterp *) ckalloc(sizeof(EnvInterp));
  130.     eiPtr->interp = interp;
  131.     eiPtr->nextPtr = firstInterpPtr;
  132.     firstInterpPtr = eiPtr;
  133.  
  134.     /*
  135.      * Store the environment variable values into the interpreter's
  136.      * "env" array, and arrange for us to be notified on future
  137.      * writes and unsets to that array.
  138.      */
  139.  
  140.     (void) Tcl_UnsetVar2(interp, "env", (char *) NULL, TCL_GLOBAL_ONLY);
  141.     for (i = 0; ; i++) {
  142.     char *p, *p2;
  143.  
  144.     p = environ[i];
  145.     if (p == NULL) {
  146.         break;
  147.     }
  148.     for (p2 = p; *p2 != '='; p2++) {
  149.         /* Empty loop body. */
  150.     }
  151.     *p2 = 0;
  152.     (void) Tcl_SetVar2(interp, "env", p, p2+1, TCL_GLOBAL_ONLY);
  153.     *p2 = '=';
  154.     }
  155.     Tcl_TraceVar2(interp, "env", (char *) NULL,
  156.         TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
  157.         EnvTraceProc, (ClientData) NULL);
  158. }
  159.  
  160. /*
  161.  *----------------------------------------------------------------------
  162.  *
  163.  * FindVariable --
  164.  *
  165.  *    Locate the entry in environ for a given name.
  166.  *
  167.  * Results:
  168.  *    The return value is the index in environ of an entry with the
  169.  *    name "name", or -1 if there is no such entry.   The integer at
  170.  *    *lengthPtr is filled in with the length of name (if a matching
  171.  *    entry is found) or the length of the environ array (if no matching
  172.  *    entry is found).
  173.  *
  174.  * Side effects:
  175.  *    None.
  176.  *
  177.  *----------------------------------------------------------------------
  178.  */
  179.  
  180. static int
  181. FindVariable(name, lengthPtr)
  182.     CONST char *name;        /* Name of desired environment variable. */
  183.     int *lengthPtr;        /* Used to return length of name (for
  184.                  * successful searches) or number of non-NULL
  185.                  * entries in environ (for unsuccessful
  186.                  * searches). */
  187. {
  188.     int i;
  189.     CONST register char *p1, *p2;
  190.  
  191.     for (i = 0, p1 = environ[i]; p1 != NULL; i++, p1 = environ[i]) {
  192.     for (p2 = name; *p2 == *p1; p1++, p2++) {
  193.         /* NULL loop body. */
  194.     }
  195.     if ((*p1 == '=') && (*p2 == '\0')) {
  196.         *lengthPtr = p2-name;
  197.         return i;
  198.     }
  199.     }
  200.     *lengthPtr = i;
  201.     return -1;
  202. }
  203.  
  204. /*
  205.  *----------------------------------------------------------------------
  206.  *
  207.  * TclSetEnv --
  208.  *
  209.  *    Set an environment variable, replacing an existing value
  210.  *    or creating a new variable if there doesn't exist a variable
  211.  *    by the given name.  This procedure is intended to be a
  212.  *    stand-in for the  UNIX "setenv" procedure so that applications
  213.  *    using that procedure will interface properly to Tcl.  To make
  214.  *    it a stand-in, the Makefile must define "TclSetEnv" to "setenv".
  215.  *
  216.  * Results:
  217.  *    None.
  218.  *
  219.  * Side effects:
  220.  *    The environ array gets updated, as do all of the interpreters
  221.  *    that we manage.
  222.  *
  223.  *----------------------------------------------------------------------
  224.  */
  225.  
  226. void
  227. TclSetEnv(name, value)
  228.     CONST char *name;        /* Name of variable whose value is to be
  229.                  * set. */
  230.     CONST char *value;        /* New value for variable. */
  231. {
  232.     int index, length, nameLength;
  233.     char *p;
  234.     EnvInterp *eiPtr;
  235.  
  236.     if (environSize == 0) {
  237.     EnvInit();
  238.     }
  239.  
  240.     /*
  241.      * Figure out where the entry is going to go.  If the name doesn't
  242.      * already exist, enlarge the array if necessary to make room.  If
  243.      * the name exists, free its old entry.
  244.      */
  245.  
  246.     index = FindVariable(name, &length);
  247.     if (index == -1) {
  248.     if ((length+2) > environSize) {
  249.         char **newEnviron;
  250.  
  251.         newEnviron = (char **) ckalloc((unsigned)
  252.             ((length+5) * sizeof(char *)));
  253.         memcpy((VOID *) newEnviron, (VOID *) environ,
  254.             length*sizeof(char *));
  255.         ckfree((char *) environ);
  256.         environ = newEnviron;
  257.         environSize = length+5;
  258.     }
  259.     index = length;
  260.     environ[index+1] = NULL;
  261.     nameLength = strlen(name);
  262.     } else {
  263.     /*
  264.      * Compare the new value to the existing value.  If they're
  265.      * the same then quit immediately (e.g. don't rewrite the
  266.      * value or propagate it to other interpeters).  Otherwise,
  267.      * when there are N interpreters there will be N! propagations
  268.      * of the same value among the interpreters.
  269.      */
  270.  
  271.     if (strcmp(value, environ[index]+length+1) == 0) {
  272.         return;
  273.     }
  274.     ckfree(environ[index]);
  275.     nameLength = length;
  276.     }
  277.  
  278.     /*
  279.      * Create a new entry and enter it into the table.
  280.      */
  281.  
  282.     p = (char *) ckalloc((unsigned) (nameLength + strlen(value) + 2));
  283.     environ[index] = p;
  284.     strcpy(p, name);
  285.     p += nameLength;
  286.     *p = '=';
  287.     strcpy(p+1, value);
  288.  
  289.     /*
  290.      * Update all of the interpreters.
  291.      */
  292.  
  293.     for (eiPtr= firstInterpPtr; eiPtr != NULL; eiPtr = eiPtr->nextPtr) {
  294.     (void) Tcl_SetVar2(eiPtr->interp, "env", (char *) name,
  295.         p+1, TCL_GLOBAL_ONLY);
  296.     }
  297. }
  298.  
  299. /*
  300.  *----------------------------------------------------------------------
  301.  *
  302.  * Tcl_PutEnv --
  303.  *
  304.  *    Set an environment variable.  Similar to setenv except that
  305.  *    the information is passed in a single string of the form
  306.  *    NAME=value, rather than as separate name strings.  This procedure
  307.  *    is intended to be a stand-in for the  UNIX "putenv" procedure
  308.  *    so that applications using that procedure will interface
  309.  *    properly to Tcl.  To make it a stand-in, the Makefile will
  310.  *    define "Tcl_PutEnv" to "putenv".
  311.  *
  312.  * Results:
  313.  *    None.
  314.  *
  315.  * Side effects:
  316.  *    The environ array gets updated, as do all of the interpreters
  317.  *    that we manage.
  318.  *
  319.  *----------------------------------------------------------------------
  320.  */
  321.  
  322. int
  323. Tcl_PutEnv(string)
  324.     CONST char *string;        /* Info about environment variable in the
  325.                  * form NAME=value. */
  326. {
  327.     int nameLength;
  328.     char *name, *value;
  329.  
  330.     if (string == NULL) {
  331.     return 0;
  332.     }
  333.  
  334.     /*
  335.      * Separate the string into name and value parts, then call
  336.      * TclSetEnv to do all of the real work.
  337.      */
  338.  
  339.     value = strchr(string, '=');
  340.     if (value == NULL) {
  341.     return 0;
  342.     }
  343.     nameLength = value - string;
  344.     if (nameLength == 0) {
  345.     return 0;
  346.     }
  347.     name = ckalloc((unsigned) nameLength+1);
  348.     memcpy(name, string, nameLength);
  349.     name[nameLength] = 0;
  350.     TclSetEnv(name, value+1);
  351.     ckfree(name);
  352.     return 0;
  353. }
  354.  
  355. /*
  356.  *----------------------------------------------------------------------
  357.  *
  358.  * TclUnsetEnv --
  359.  *
  360.  *    Remove an environment variable, updating the "env" arrays
  361.  *    in all interpreters managed by us.  This function is intended
  362.  *    to replace the UNIX "unsetenv" function (but to do this the
  363.  *    Makefile must be modified to redefine "TclUnsetEnv" to
  364.  *    "unsetenv".
  365.  *
  366.  * Results:
  367.  *    None.
  368.  *
  369.  * Side effects:
  370.  *    Interpreters are updated, as is environ.
  371.  *
  372.  *----------------------------------------------------------------------
  373.  */
  374.  
  375. void
  376. TclUnsetEnv(name)
  377.     CONST char *name;            /* Name of variable to remove. */
  378. {
  379.     int index, dummy;
  380.     char **envPtr;
  381.     EnvInterp *eiPtr;
  382.  
  383.     if (environSize == 0) {
  384.     EnvInit();
  385.     }
  386.  
  387.     /*
  388.      * Update the environ array.
  389.      */
  390.  
  391.     index = FindVariable(name, &dummy);
  392.     if (index == -1) {
  393.     return;
  394.     }
  395.     ckfree(environ[index]);
  396.     for (envPtr = environ+index+1; ; envPtr++) {
  397.     envPtr[-1] = *envPtr;
  398.     if (*envPtr == NULL) {
  399.         break;
  400.        }
  401.     }
  402.  
  403.     /*
  404.      * Update all of the interpreters.
  405.      */
  406.  
  407.     for (eiPtr = firstInterpPtr; eiPtr != NULL; eiPtr = eiPtr->nextPtr) {
  408.     (void) Tcl_UnsetVar2(eiPtr->interp, "env", (char *) name,
  409.         TCL_GLOBAL_ONLY);
  410.     }
  411. }
  412.  
  413. /*
  414.  *----------------------------------------------------------------------
  415.  *
  416.  * EnvTraceProc --
  417.  *
  418.  *    This procedure is invoked whenever an environment variable
  419.  *    is modified or deleted.  It propagates the change to the
  420.  *    "environ" array and to any other interpreters for whom
  421.  *    we're managing an "env" array.
  422.  *
  423.  * Results:
  424.  *    Always returns NULL to indicate success.
  425.  *
  426.  * Side effects:
  427.  *    Environment variable changes get propagated.  If the whole
  428.  *    "env" array is deleted, then we stop managing things for
  429.  *    this interpreter (usually this happens because the whole
  430.  *    interpreter is being deleted).
  431.  *
  432.  *----------------------------------------------------------------------
  433.  */
  434.  
  435.     /* ARGSUSED */
  436. static char *
  437. EnvTraceProc(clientData, interp, name1, name2, flags)
  438.     ClientData clientData;    /* Not used. */
  439.     Tcl_Interp *interp;        /* Interpreter whose "env" variable is
  440.                  * being modified. */
  441.     char *name1;        /* Better be "env". */
  442.     char *name2;        /* Name of variable being modified, or
  443.                  * NULL if whole array is being deleted. */
  444.     int flags;            /* Indicates what's happening. */
  445. {
  446.     /*
  447.      * First see if the whole "env" variable is being deleted.  If
  448.      * so, just forget about this interpreter.
  449.      */
  450.  
  451.     if (name2 == NULL) {
  452.     register EnvInterp *eiPtr, *prevPtr;
  453.  
  454.     if ((flags & (TCL_TRACE_UNSETS|TCL_TRACE_DESTROYED))
  455.         != (TCL_TRACE_UNSETS|TCL_TRACE_DESTROYED)) {
  456.         panic("EnvTraceProc called with confusing arguments");
  457.     }
  458.     eiPtr = firstInterpPtr;
  459.     if (eiPtr->interp == interp) {
  460.         firstInterpPtr = eiPtr->nextPtr;
  461.     } else {
  462.         for (prevPtr = eiPtr, eiPtr = eiPtr->nextPtr; ;
  463.             prevPtr = eiPtr, eiPtr = eiPtr->nextPtr) {
  464.         if (eiPtr == NULL) {
  465.             panic("EnvTraceProc couldn't find interpreter");
  466.         }
  467.         if (eiPtr->interp == interp) {
  468.             prevPtr->nextPtr = eiPtr->nextPtr;
  469.             break;
  470.         }
  471.         }
  472.     }
  473.     ckfree((char *) eiPtr);
  474.     return NULL;
  475.     }
  476.  
  477.     /*
  478.      * If a value is being set, call TclSetEnv to do all of the work.
  479.      */
  480.  
  481.     if (flags & TCL_TRACE_WRITES) {
  482.     TclSetEnv(name2, Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY));
  483.     }
  484.  
  485.     if (flags & TCL_TRACE_UNSETS) {
  486.     TclUnsetEnv(name2);
  487.     }
  488.     return NULL;
  489. }
  490.  
  491. /*
  492.  *----------------------------------------------------------------------
  493.  *
  494.  * EnvInit --
  495.  *
  496.  *    This procedure is called to initialize our management
  497.  *    of the environ array.
  498.  *
  499.  * Results:
  500.  *    None.
  501.  *
  502.  * Side effects:
  503.  *    Environ gets copied to malloc-ed storage, so that in
  504.  *    the future we don't have to worry about which entries
  505.  *    are malloc-ed and which are static.
  506.  *
  507.  *----------------------------------------------------------------------
  508.  */
  509.  
  510. static void
  511. EnvInit()
  512. {
  513.     char **newEnviron;
  514.     int i, length;
  515.  
  516.     if (environSize != 0) {
  517.     return;
  518.     }
  519.     for (length = 0; environ[length] != NULL; length++) {
  520.     /* Empty loop body. */
  521.     }
  522.     environSize = length+5;
  523.     newEnviron = (char **) ckalloc((unsigned)
  524.         (environSize * sizeof(char *)));
  525.     for (i = 0; i < length; i++) {
  526.     newEnviron[i] = (char *) ckalloc((unsigned) (strlen(environ[i]) + 1));
  527.     strcpy(newEnviron[i], environ[i]);
  528.     }
  529.     newEnviron[length] = NULL;
  530.     environ = newEnviron;
  531. }
  532.